計算論的臨床心理学サマースクール2025
2025-08-07
大水拓海(おおみず たくみ)
専修大学大学院文学研究科心理学専攻修士課程2年
心理療法の作用機序,感情粒度,心理ネットワーク,
シミュレーション,能動的推論
なぜネットワークからシミュレーションを行うか?
実際の臨床データを使用することの困難さ(入手,使用)
侵襲性の問題を超えて介入を試す,予測する
新たな仮説の生成
ネットワークの結合を強めるパラメータ\(c\)の値が症状全体の活性化を左右する
\[A^{t}_{i} = \sum^{J}_{j=1} cW_{ij}X^{t-1}_j\tag{1}\]
\[P(X^{t}_{i} = 1) = \frac{1}{1+e^{b_{i}}-A^{t}_i} \tag{2}\]
Cramerのモデルでは症状のみの接続の強さに着目
実データにおいて症状が改善しても接続が強まっていることが報告(Höller et al, 2022)
→心理療法などの治療的な要素を入れて拡張することで,ネットワークの中でどの症状を標的にすれば大きな治療効果が得られるかシミュレーションできる
シミュレーションを実際に行ってみる
ネットワークシミュレーションを実行する関数を
パッケージにしてまとめました
ご自身のRコンソールに以下をコピペして,パッケージをインストールしてください
W_init:第1引数。症状ネットワークの重み。
b_init:第2引数。各ノードの活性化閾値。
target:どのノードを標的とするかを選択するリスト/ベクトル。介入するノードは1,介入しないノードは0にする。
上記は必須の引数です。
他にもいろいろオプションがあります。
仮想データの作成
# Example data for a 6-symptom network
set.seed(456)
weight_6 <- matrix(rnorm(6*6, mean = 0.2, sd = 0.08), nrow = 6, ncol = 6)
diag(weight_6) <- 0
weight_6[upper.tri(weight_6)] <- t(weight_6)[upper.tri(weight_6)]
print(weight_6) [,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.00000000 0.2497420 0.2640700 0.08888861 0.14285145 0.1740751
[2,] 0.24974204 0.0000000 0.2805882 0.24585877 0.12673516 0.3048878
[3,] 0.26406997 0.2805882 0.0000000 0.35578851 0.33895489 0.2309987
[4,] 0.08888861 0.2458588 0.3557885 0.00000000 0.08585358 0.2166589
[5,] 0.14285145 0.1267352 0.3389549 0.08585358 0.00000000 0.1128498
[6,] 0.17407512 0.3048878 0.2309987 0.21665887 0.11284977 0.0000000
threshold
1 0.2669698
2 0.2929874
3 0.2788010
4 0.2980632
5 0.2985529
6 0.3196519
ターゲットとノード名の設定
シミュレーションの実行
# Run the simulation with custom parameters
sim_results <- simulate_treatment_network(
W_init = weight_6,
b_init = threshold_6$threshold,
target = target_list_6,
connectivity = 1.2,
edge_between_TC = 0.8,
weight_bias = 1.2,
TB = 1,
trial = 10, # Example: Overriding default 10
baseline_iteration = 10, # Example: Overriding default 10
num_TC = 5, # Example: Overriding default 5
TC_iteration_per_component = 10, # Example: Overriding default 10
follow_up_iteration = 10, # Example: Overriding default 10
symptom_name = custom_symptom_names_6
)シミュレーション結果
先ほど推定したIsing modelの重みと閾値を使って,シミュレーション
単独の症状を標的とした場合,どの症状への介入が最も効果的か?
複数の症状を標的とした場合,どのような組み合わせが効果的か?
症状を悪化させてしまう組み合わせはあるか?
その他,どんな条件だとどんなことが起きそうか?
不安のオープンデータをダウンロードしてカレントディレクトリに保存する。
# Isingのデータを使ってシミュレーションする
library(tidyverse)
library(foreign)
library(bootnet)
library(qgraph)
library(IsingFit)
# データの読み込み
data <- read.spss("data/pone.0182162.s004.sav",
to.data.frame=TRUE)
# データの整理(GADに絞って実行)
data_gad <- data %>%
rename(gad7a = S_GAD7_a, gad7b = S_GAD7_b,
gad7c = S_GAD7_c, gad7d = S_GAD7_d,
gad7e = S_GAD7_e, gad7f = S_GAD7_f,
gad7g = S_GAD7_g) %>%
select(gad7a, gad7b, gad7c, gad7d, gad7e, gad7f, gad7g)
data_gad %>% head() gad7a gad7b gad7c gad7d gad7e gad7f gad7g
1 1 0 0 0 3 2 2
2 0 0 0 0 0 1 0
3 0 0 0 0 0 1 0
4 0 0 0 0 0 0 0
5 0 0 0 0 0 1 0
6 3 2 1 3 3 1 1
gad7a gad7b gad7c gad7d gad7e gad7f gad7g
gad7a 0.0000000 1.0439830 0.7587986 1.0914346 0.4889163 0.3086700 1.1322104
gad7b 1.0439830 0.0000000 1.9008079 0.9338190 0.3776924 0.3382065 0.9932868
gad7c 0.7587986 1.9008079 0.0000000 0.9125330 0.0000000 0.5227649 0.8279194
gad7d 1.0914346 0.9338190 0.9125330 0.0000000 1.3452892 0.8934315 0.2867852
gad7e 0.4889163 0.3776924 0.0000000 1.3452892 0.0000000 0.9192592 0.6740093
gad7f 0.3086700 0.3382065 0.5227649 0.8934315 0.9192592 0.0000000 0.3999585
gad7g 1.1322104 0.9932868 0.8279194 0.2867852 0.6740093 0.3999585 0.0000000
gad7a gad7b gad7c gad7d gad7e gad7f gad7g
-1.815663 -3.516485 -2.132813 -1.795428 -3.007363 -1.267546 -2.971828
$result_plot
TableGrob (1 x 2) "arrange": 2 grobs
z cells name grob
1 1 (1-1,1-1) arrange gtable[layout]
2 2 (1-1,2-2) arrange gtable[layout]
$result_text
[1] "The mean value of symptom at the final step(t=120). = 0.557\nThe mean value of treatment component at the final step(t=120). = 1.000\nThe SD value of symptom at the final step(t=120). = 0.218\nThe SD value of treatment component at the final step(t=120). = 0.000"